1 Introduction

This report describes exploratory analysis of changes in air quality in the City of Southampton, UK in Spring 2020.

lastHA <- max(fixedDT[source == "hantsAir"]$dateTimeUTC)
diffHA <- lubridate::now() - lastHA
lastAURN <- max(fixedDT[source == "AURN"]$dateTimeUTC)
diffAURN <- lubridate::now() - lastAURN

Data for Southampton downloaded from :

Southampton City Council collects various forms of air quality data at the sites shown in Table 1.1. The data is available in raw form from http://www.hantsair.org.uk/hampshire/asp/Bulletin.asp?la=Southampton&bulletin=daily&site=SH5.

Some of these sites feed data to AURN. The data that goes via AURN is ratified to check for outliers and instrument/measurement error. AURN data less than six months old has not undergone this process. AURN data is (c) Crown 2020 copyright Defra and available for re-use via https://uk-air.defra.gov.uk, licenced under the Open Government Licence (OGL).

In this report we use data from the following sources:

http://www.hantsair.org.uk/hampshire/asp/Bulletin.asp?la=Southampton last updated at 2020-06-03 16:00:00;
https://uk-air.defra.gov.uk/networks/network-info?view=aurn last updated at 2020-06-02 23:00:00.

Table 1.1 shows the available sites and sources. Note that some of the non-AURN sites appear to have stopped updating recently. For a detailed analysis of recent missing data see Section 12.1.

t <- fixedDT[!is.na(value), .(nObs = .N, firstData = min(dateTimeUTC), latestData = max(dateTimeUTC), nMeasures = uniqueN(pollutant)), 
    keyby = .(site, source)]

kableExtra::kable(t, caption = "Sites, data source and number of valid observations. note that measures includes wind speed and direction in the AURN sourced data", 
    digits = 2) %>% kable_styling()

Table 1.1: Sites, data source and number of valid observations. note that measures includes wind speed and direction in the AURN sourced data
site	source	nObs	firstData	latestData	nMeasures
Southampton - A33 Roadside (near docks, AURN site)	hantsAir	85576	2017-01-01 00:00:00	2020-06-03 16:00:00	3
Southampton - Background (near city centre, AURN site)	hantsAir	161581	2017-01-25 11:00:00	2020-06-03 16:00:00	6
Southampton - Onslow Road (near RSH)	hantsAir	82232	2017-01-01 00:00:00	2020-04-15 07:00:00	3
Southampton - Victoria Road (Woolston)	hantsAir	60078	2017-01-01 00:00:00	2020-04-01 06:00:00	3
Southampton A33 (via AURN)	AURN	219302	2017-01-01 00:00:00	2020-06-02 23:00:00	8
Southampton Centre (via AURN)	AURN	342142	2017-01-01 00:00:00	2020-06-02 23:00:00	13

To avoid confusion and ‘double counting’, in the remainder of the analysis we replace the Southampton AURN site data with the data for the same site sourced via AURN as shown in Table 1.2. This has the disadvantage that the data is slightly less up to date (see Table 1.1). As will be explained below in the comparative analysis we will use only the AURN data to avoid missing data issues.

fixedDT <- fixedDT[!(site %like% "AURN site")]

t <- fixedDT[!is.na(value), .(nObs = .N, nPollutants = uniqueN(pollutant), lastDate = max(dateTimeUTC)), 
    keyby = .(site, source)]

kableExtra::kable(t, caption = "Sites, data source and number of valid observations", digits = 2) %>% kable_styling()

Table 1.2: Sites, data source and number of valid observations
site	source	nObs	nPollutants	lastDate
Southampton - Onslow Road (near RSH)	hantsAir	82232	3	2020-04-15 07:00:00
Southampton - Victoria Road (Woolston)	hantsAir	60078	3	2020-04-01 06:00:00
Southampton A33 (via AURN)	AURN	219302	8	2020-06-02 23:00:00
Southampton Centre (via AURN)	AURN	342142	13	2020-06-02 23:00:00

We use this data to compare:

pre and during-lockdown air quality measures
air quality measures during lockdown 2020 with average measures for the same time periods in the preceding 3 years (2017-2019)

It should be noted that air pollution levels in any given period of time are highly dependent on the prevailing meteorological conditions. As a result it can be very difficult to disentangle the affects of a reduction in source strength from the affects of local surface conditions. This is abundantly clear in the analysis which follows given that the Easter weekend was forecast to have very high import of pollution from Europe and that the wind direction and speed was highly variable across the lockdown period (see Figure 9.1).

Further, air quality is not wholly driven by sources that lockdown might suppress and indeed that suppression may lead to rebound affects. For example we might expect more emissions due to increased domestic heating during cooler lockdown periods. As a result the analysis presented below must be considered a preliminary ‘before meteorological adjustment’ and ‘before controlling for other sources’ analysis of the affect of lockdown on air quality in Southampton.

For much more detailed analysis see a longer and very messy data report.

2 WHO air quality thresholds

A number of the following plots show the relevant WHO air quality thresholds and limits. These are taken from:

https://www.who.int/news-room/fact-sheets/detail/ambient-(outdoor)-air-quality-and-health

3 Nitrogen Dioxide (no2)

yLab <- "Nitrogen Dioxide (ug/m3)"
no2dt <- fixedDT[pollutant == "no2"]

Figure 3.1 shows the most recent hourly data.

recentDT <- no2dt[obsDate > myParams$recentCutDate]
p <- makeDotPlot(recentDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "value", byVar = "site", 
    yLab = yLab)

p <- p + scale_x_datetime(date_breaks = "2 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1))

p <- p + geom_hline(yintercept = myParams$hourlyNo2Threshold_WHO) + labs(caption = paste0(myParams$lockdownCap, 
    myParams$weekendCap, "\nReference line = WHO hourly threshold (", myParams$hourlyNo2Threshold_WHO, 
    ")"))

# final plot - adds annotations
yMin <- min(recentDT$value)
yMax <- max(recentDT$value)

p <- addLockdownRectDateTime(p, yMin, yMax)
addWeekendsDateTime(p, yMin, yMax) + guides(colour = guide_legend(ncol = 2))

Figure 3.1: Nitrogen Dioxide levels, Southampton (hourly, recent)

Figure 3.2 shows the most recent hourly data by date and time of day.

recentDT[, `:=`(time, hms::as_hms(dateTimeUTC))]
yMin <- min(recentDT$time)
yMax <- max(recentDT$time)
p <- profileTilePlot(recentDT, yLab)
p <- addLockdownRectDate(p, yMin, yMax)
addWeekendsDate(p, yMin, yMax) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap))

Figure 3.2: Nitrogen Dioxide levels, Southampton (hourly, recent)

Figure 3.3 shows the most recent mean daily values compared to previous years for the two AURN sites which do not have missing data. We have shifted the dates for the comparison years to ensure that weekdays and weekends line up. Note that this plot shows daily means with no indications of variance. Visible differences are therefore purely indicative at this stage.

plotDT <- no2dt[site %like% "via AURN" & fixedDate <= lubridate::today() & fixedDate >= myParams$comparePlotCut, 
    .(meanVal = mean(value), medianVal = median(value), nSites = uniqueN(site)), keyby = .(fixedDate, compareYear, 
        site)]

# final plot - adds annotations
yMin <- min(plotDT$meanVal)
yMax <- max(plotDT$meanVal)

p <- compareYearsPlot(plotDT, xVar = "fixedDate", yVar = "meanVal", colVar = "compareYear")

p <- addLockdownRectDate(p, yMin, yMax) + labs(x = "Date", y = "Daily mean", caption = paste0(myParams$lockdownCap, 
    myParams$weekendCap, myParams$noThresh))

p <- addWeekendsDate(p, yMin, yMax) + scale_x_date(date_breaks = "7 day", date_labels = "%a %d %b", date_minor_breaks = "1 day")

p + facet_grid(site ~ .) + theme(strip.text.y.right = element_text(angle = 90))

Figure 3.3: Comparative Nitrogen Dioxide levels 2020 vs 2017-2019, Southampton (daily mean)

Figure 3.4 and 3.5 show the % difference between the daily means for 2020 vs 2017-2019 (reference period). In both cases we can see that NO2 levels in 2020 were generally already lower than the reference period yet are not consistently lower even during the lockdown period. The affects of covid lockdown are not clear cut…

dailyDT <- makeDailyComparisonDT(no2dt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotDaily(dailyDT) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap))

yMin <- min(dailyDT$pcDiffMean)
yMax <- max(dailyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-93"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:124"

p <- addLockdownRectDate(p, yMin, yMax)
addWeekendsDate(p, yMin, yMax)

Figure 3.4: Percentage difference in daily mean Nitrogen Dioxide levels 2020 vs 2017-2019, Southampton

weeklyDT <- makeWeeklyComparisonDT(no2dt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotWeekly(weeklyDT, ldStart = myParams$lockDownStartDate, ldEnd = myParams$lockDownEndDate) + 
    labs(caption = paste0(myParams$lockdownCap))

yMin <- min(weeklyDT$pcDiffMean)
yMax <- max(weeklyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-64"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:38"

addLockdownRectWeek(p, yMin, yMax)

Figure 3.5: Percentage difference in weekly mean Nitrogen Dioxide levels 2020 vs 2017-2019, Southampton

Beware seasonal trends and meteorological affects

4 Oxides of Nitrogen (nox)

yLab <- "Oxides of Nitrogen (ug/m3)"
noxdt <- fixedDT[pollutant == "nox"]

Figure 4.1 shows the most recent hourly data.

recentDT <- noxdt[!is.na(value) & obsDate > myParams$recentCutDate]
p <- makeDotPlot(recentDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "value", byVar = "site", 
    yLab = yLab)

p <- p + scale_x_datetime(date_breaks = "2 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1)) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap, myParams$noThresh))

# final plot - adds annotations
yMin <- min(recentDT$value)
yMax <- max(recentDT$value)

p <- addLockdownRectDateTime(p, yMin, yMax)

addWeekendsDateTime(p, yMin, yMax)

Figure 4.1: Oxides of nitrogen levels, Southampton (hourly, recent)

Figure 4.2 shows the most recent hourly data by date and time of day.

recentDT[, `:=`(time, hms::as_hms(dateTimeUTC))]
yMin <- min(recentDT$time)
yMax <- max(recentDT$time)
p <- profileTilePlot(recentDT, yLab)
addWeekendsDate(p, yMin, yMax) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap))

Figure 4.2: Oxides of nitrogen levels, Southampton (hourly, recent)

Figure 4.3 shows the most recent mean daily values compared to previous years for the two AURN sites.

plotDT <- noxdt[site %like% "via AURN" & fixedDate <= lubridate::today() & fixedDate >= myParams$comparePlotCut, 
    .(meanVal = mean(value), medianVal = median(value), nSites = uniqueN(site)), keyby = .(fixedDate, compareYear, 
        site)]

# final plot - adds annotations
yMin <- min(plotDT$meanVal)
yMax <- max(plotDT$meanVal)

p <- compareYearsPlot(plotDT, xVar = "fixedDate", yVar = "meanVal", colVar = "compareYear")
p <- addLockdownRectDate(p, yMin, yMax) + labs(x = "Date", y = "Daily mean", caption = paste0(myParams$lockdownCap, 
    myParams$weekendCap, myParams$noThresh))
p <- addWeekendsDate(p, yMin, yMax)

p + facet_grid(site ~ .) + theme(strip.text.y.right = element_text(angle = 90))

Figure 4.3: Oxides of nitrogen levels, Southampton (daily mean)

Figure 4.4 and 4.5 show the % difference between the daily and weekly means for 2020 vs 2017-2019 (reference period).

dailyDT <- makeDailyComparisonDT(noxdt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotDaily(dailyDT) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap))

yMin <- min(dailyDT$pcDiffMean)
yMax <- max(dailyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-96"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:172"

p <- addLockdownRectDate(p, yMin, yMax)
addWeekendsDate(p, yMin, yMax)

Figure 4.4: % difference in daily mean Oxides of Nitrogen levels 2020 vs 2017-2019, Southampton

weeklyDT <- makeWeeklyComparisonDT(noxdt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotWeekly(weeklyDT, ldStart = myParams$lockDownStartDate, ldEnd = myParams$lockDownEndDate) + 
    labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap))

yMin <- min(weeklyDT$pcDiffMean)
yMax <- max(weeklyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-70"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:51"

addLockdownRectWeek(p, yMin, yMax)

Figure 4.5: % difference in weekly mean Oxides of Nitrogen levels 2020 vs 2017-2019, Southampton

5 Sulphour Dioxide

yLab <- "Sulphour Dioxide (ug/m3)"
so2dt <- fixedDT[pollutant == "so2"]

Figure 5.1 shows the most recent hourly data.

recentDT <- so2dt[!is.na(value) & obsDate > myParams$recentCutDate]
p <- makeDotPlot(recentDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "value", byVar = "site", 
    yLab = yLab)

p <- p + scale_x_datetime(date_breaks = "2 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1)) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap, myParams$noThresh))

yMax <- max(recentDT$value)
yMin <- min(recentDT$value)
p <- addLockdownRectDateTime(p, yMin, yMax)
addWeekendsDateTime(p, yMin, yMax)

Figure 5.1: Sulphour Dioxide levels, Southampton (hourly, recent)

Figure 5.2 shows the most recent hourly data by date and time of day and time of day.

recentDT[, `:=`(time, hms::as_hms(dateTimeUTC))]

yMin <- min(recentDT$time)
yMax <- max(recentDT$time)
p <- profileTilePlot(recentDT, yLab)
addWeekendsDate(p, yMin, yMax) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap))

Figure 5.2: Sulphour Dioxide levels, Southampton (hourly, recent)

Figure 5.3 shows the most recent mean daily values compared to previous years.

plotDT <- so2dt[site %like% "via AURN" & fixedDate <= lubridate::today() & fixedDate >= myParams$comparePlotCut, 
    .(meanVal = mean(value), medianVal = median(value), nSites = uniqueN(site)), keyby = .(fixedDate, compareYear, 
        site)]

# final plot - adds annotations
yMin <- min(plotDT$mean)
yMax <- max(plotDT$mean)

p <- compareYearsPlot(plotDT, xVar = "fixedDate", yVar = "meanVal", colVar = "compareYear")
p <- addLockdownRectDate(p, yMin, yMax) + geom_hline(yintercept = myParams$dailySo2Threshold_WHO) + labs(x = "Date", 
    y = "Daily mean", caption = paste0(myParams$lockdownCap, myParams$weekendCap, "\nReference line = WHO daily threshold (", 
        myParams$dailySo2Threshold_WHO, ")"))
p <- addWeekendsDate(p, yMin, yMax)

p + facet_grid(site ~ .) + theme(strip.text.y.right = element_text(angle = 90))

Figure 5.3: Sulphour dioxide levels, Southampton (daily mean)

Figure 5.4 and 5.5 show the % difference between the daily and weekly means for 2020 vs 2017-2019 (reference period).

dailyDT <- makeDailyComparisonDT(so2dt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotDaily(dailyDT) + labs(caption = paste0(myParams$lockdownCap))

yMin <- min(dailyDT$pcDiffMean)
yMax <- max(dailyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-75"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:714"

p <- addLockdownRectDate(p, yMin, yMax)
addWeekendsDate(p, yMin, yMax)

Figure 5.4: % difference in daily mean Sulphour Dioxide levels 2020 vs 2017-2019, Southampton

weeklyDT <- makeWeeklyComparisonDT(so2dt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotWeekly(weeklyDT, ldStart = myParams$lockDownStartDate, ldEnd = myParams$lockDownEndDate) + 
    labs(caption = paste0(myParams$lockdownCap))

yMin <- min(weeklyDT$pcDiffMean)
yMax <- max(weeklyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-48"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:262"

addLockdownRectWeek(p, yMin, yMax)

Figure 5.5: % difference in weekly mean Sulphour Dioxide levels 2020 vs 2017-2019, Southampton

Beware seasonal trends and meteorological affects

6 Ozone

yLab <- "Ozone (ug/m3)"
o3dt <- fixedDT[pollutant == "o3"]

Figure 6.1 shows the most recent hourly data.

recentDT <- o3dt[!is.na(value) & obsDate > myParams$recentCutDate]
p <- makeDotPlot(recentDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "value", byVar = "site", 
    yLab = yLab)

p <- p + scale_x_datetime(date_breaks = "2 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1)) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap, myParams$noThresh))

yMax <- max(recentDT$value)
yMin <- min(recentDT$value)
p <- addLockdownRectDateTime(p, yMin, yMax)
addWeekendsDateTime(p, yMin, yMax)

Figure 6.1: 03 levels, Southampton (hourly, recent)

Figure 6.2 shows the most recent hourly data by date and time of day.

recentDT[, `:=`(time, hms::as_hms(dateTimeUTC))]

yMin <- min(recentDT$time)
yMax <- max(recentDT$time)
p <- profileTilePlot(recentDT, yLab)
addWeekendsDate(p, yMin, yMax) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap))

Figure 6.2: Ozone levels, Southampton (hourly, recent)

Figure 6.3 shows the most recent mean daily values compared to previous years.

plotDT <- o3dt[site %like% "via AURN" & fixedDate <= lubridate::today() & fixedDate >= myParams$comparePlotCut, 
    .(meanVal = mean(value), medianVal = median(value), nSites = uniqueN(site)), keyby = .(fixedDate, compareYear, 
        site)]

# final plot - adds annotations
yMin <- min(plotDT$mean)
yMax <- max(plotDT$mean)

p <- compareYearsPlot(plotDT, xVar = "fixedDate", yVar = "meanVal", colVar = "compareYear")
p <- addLockdownRectDate(p, yMin, yMax) + geom_hline(yintercept = myParams$dailyO3Threshold_WHO) + labs(x = "Date", 
    y = "Daily mean", caption = paste0(myParams$lockdownCap, myParams$weekendCap, "\nReference line = WHO daily threshold (", 
        myParams$dailyO3Threshold_WHO, ")"))
p <- addWeekendsDate(p, yMin, yMax)
p + facet_grid(site ~ .) + theme(strip.text.y.right = element_text(angle = 90))

Figure 6.3: Ozone levels, Southampton (daily mean)

Figure 6.4 and 6.5 show the % difference between the daily and weekly means for 2020 vs 2017-2019 (reference period).

dailyDT <- makeDailyComparisonDT(o3dt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotDaily(dailyDT) + labs(caption = paste0(myParams$lockdownCap))

yMin <- min(dailyDT$pcDiffMean)
yMax <- max(dailyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-53"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:121"

p <- addLockdownRectDate(p, yMin, yMax)
addWeekendsDate(p, yMin, yMax)

Figure 6.4: % difference in daily mean Ozone levels 2020 vs 2017-2019, Southampton

weeklyDT <- makeWeeklyComparisonDT(o3dt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotWeekly(weeklyDT, ldStart = myParams$lockDownStartDate, ldEnd = myParams$lockDownEndDate) + 
    labs(caption = paste0(myParams$lockdownCap))

yMin <- min(weeklyDT$pcDiffMean)
yMax <- max(weeklyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:1"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:87"

addLockdownRectWeek(p, yMin, yMax)

Figure 6.5: % difference in weekly mean Ozone levels 2020 vs 2017-2019, Southampton

Beware seasonal trends and meteorological affects

7 PM 10

yLab <- "PM 10 (ug/m3)"
pm10dt <- fixedDT[pollutant == "pm10"]

Figure 7.1 shows the most recent hourly data.

recentDT <- pm10dt[!is.na(value) & obsDate > myParams$recentCutDate]
p <- makeDotPlot(recentDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "value", byVar = "site", 
    yLab = yLab)

p <- p + scale_x_datetime(date_breaks = "2 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1)) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap, myParams$noThresh))

yMax <- max(recentDT$value)
yMin <- min(recentDT$value)
p <- addLockdownRectDateTime(p, yMin, yMax)
addWeekendsDateTime(p, yMin, yMax)

Figure 7.1: PM10 levels, Southampton (hourly, recent)

Figure 7.2 shows the most recent hourly data by date and time of day.

recentDT[, `:=`(time, hms::as_hms(dateTimeUTC))]

yMin <- min(recentDT$time)
yMax <- max(recentDT$time)
p <- profileTilePlot(recentDT, yLab)
addWeekendsDate(p, yMin, yMax) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap))

Figure 7.2: PM10 levels, Southampton (hourly, recent)

Figure 7.3 shows the most recent mean daily values compared to previous years.

plotDT <- pm10dt[site %like% "via AURN" & fixedDate <= lubridate::today() & fixedDate >= myParams$comparePlotCut, 
    .(meanVal = mean(value), medianVal = median(value), nSites = uniqueN(site)), keyby = .(fixedDate, compareYear, 
        site)]

# final plot - adds annotations
yMin <- min(plotDT$mean)
yMax <- max(plotDT$mean)

p <- compareYearsPlot(plotDT, xVar = "fixedDate", yVar = "meanVal", colVar = "compareYear")
p <- addLockdownRectDate(p, yMin, yMax) + geom_hline(yintercept = myParams$dailyPm10Threshold_WHO) + labs(x = "Date", 
    y = "Daily mean", caption = paste0(myParams$lockdownCap, myParams$weekendCap, "\nReference line = WHO daily threshold (", 
        myParams$dailyPm10Threshold_WHO, ")"))
p <- addWeekendsDate(p, yMin, yMax)
p + facet_grid(site ~ .) + theme(strip.text.y.right = element_text(angle = 90))

Figure 7.3: PM10 levels, Southampton (daily mean)

Figure 7.4 and 7.5 show the % difference between the daily and weekly means for 2020 vs 2017-2019 (reference period).

dailyDT <- makeDailyComparisonDT(pm10dt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotDaily(dailyDT) + labs(caption = paste0(myParams$lockdownCap))

yMin <- min(dailyDT$pcDiffMean)
yMax <- max(dailyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-79"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:203"

p <- addLockdownRectDate(p, yMin, yMax)
addWeekendsDate(p, yMin, yMax)

Figure 7.4: % difference in daily mean PM10 levels 2020 vs 2017-2019, Southampton

weeklyDT <- makeWeeklyComparisonDT(pm10dt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotWeekly(weeklyDT, ldStart = myParams$lockDownStartDate, ldEnd = myParams$lockDownEndDate) + 
    labs(caption = paste0(myParams$lockdownCap))

yMin <- min(weeklyDT$pcDiffMean)
yMax <- max(weeklyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-46"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:81"

addLockdownRectWeek(p, yMin, yMax)

Figure 7.5: % difference in weekly mean PM10 levels 2020 vs 2017-2019, Southampton

Beware seasonal trends and meteorological affects

8 PM 2.5

yLab <- "PM 2.5 (ug/m3)"
pm25dt <- fixedDT[pollutant == "pm2.5"]

Figure 8.1 shows the most recent hourly data.

recentDT <- pm25dt[!is.na(value) & obsDate > myParams$recentCutDate]
p <- makeDotPlot(recentDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "value", byVar = "site", 
    yLab = yLab)

p <- p + scale_x_datetime(date_breaks = "2 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1)) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap, myParams$noThresh))

yMax <- max(recentDT$value)
yMin <- min(recentDT$value)
p <- addLockdownRectDateTime(p, yMin, yMax)
addWeekendsDateTime(p, yMin, yMax)

Figure 8.1: PM2.5 levels, Southampton (hourly, recent)

Figure 8.2 shows the most recent hourly data by date and time of day.

recentDT[, `:=`(time, hms::as_hms(dateTimeUTC))]

yMin <- min(recentDT$time)
yMax <- max(recentDT$time)
p <- profileTilePlot(recentDT, yLab)
addWeekendsDate(p, yMin, yMax) + labs(caption = paste0(myParams$lockdownCap, myParams$weekendCap))

Figure 8.2: PM2.5 levels, Southampton (hourly, recent)

Figure 8.3 shows the most recent mean daily values compared to previous years.

plotDT <- pm25dt[site %like% "via AURN" & fixedDate <= lubridate::today() & fixedDate >= myParams$comparePlotCut, 
    .(meanVal = mean(value), medianVal = median(value), nSites = uniqueN(site)), keyby = .(fixedDate, compareYear, 
        site)]

# final plot - adds annotations
yMin <- min(plotDT$mean)
yMax <- max(plotDT$mean)

p <- compareYearsPlot(plotDT, xVar = "fixedDate", yVar = "meanVal", colVar = "compareYear")
p <- addLockdownRectDate(p, yMin, yMax) + geom_hline(yintercept = myParams$dailyPm2.5Threshold_WHO) + labs(x = "Date", 
    y = "Daily mean", caption = paste0(myParams$lockdownCap, myParams$weekendCap, "\nReference line = WHO daily threshold (", 
        myParams$dailyPm2.5Threshold_WHO, ")"))
p <- addWeekendsDate(p, yMin, yMax)
p + facet_grid(site ~ .) + theme(strip.text.y.right = element_text(angle = 90))

Figure 8.3: PM2.5 levels, Southampton (daily mean)

Figure 8.4 and 8.5 show the % difference between the daily and weekly means for 2020 vs 2017-2019 (reference period).

dailyDT <- makeDailyComparisonDT(pm25dt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotDaily(dailyDT) + labs(caption = paste0(myParams$lockdownCap))

yMin <- min(dailyDT$pcDiffMean)
yMax <- max(dailyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-81"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:263"

p <- addLockdownRectDate(p, yMin, yMax)
addWeekendsDate(p, yMin, yMax)

Figure 8.4: % difference in daily mean PM2.5 levels 2020 vs 2017-2019, Southampton

weeklyDT <- makeWeeklyComparisonDT(pm25dt[site %like% "via AURN" & fixedDate >= myParams$comparePlotCut])

p <- compareYearsDiffPlotWeekly(weeklyDT, ldStart = myParams$lockDownStartDate, ldEnd = myParams$lockDownEndDate) + 
    labs(caption = paste0(myParams$lockdownCap))

yMin <- min(weeklyDT$pcDiffMean)
yMax <- max(weeklyDT$pcDiffMean)
print(paste0("Max drop %:", round(yMin)))

## [1] "Max drop %:-54"

print(paste0("Max increase %:", round(yMax)))

## [1] "Max increase %:95"

addLockdownRectWeek(p, yMin, yMax)

Figure 8.5: % difference in weekly mean PM2.5 levels 2020 vs 2017-2019, Southampton

Beware seasonal trends and meteorological affects

9 Wind direction and speed

As noted above, air pollution levels in any given time period are highly dependent on the prevailing meteorological conditions.

Figure 9.1 shows the wind direction and speed over the period of lockdown and can be compared with the equivalent pollutant level plots above such as Figure 3.1.

# windDT[, .(mean = mean(wd)), keyby = .(site)] # they're identical across AURN sites
windDirDT <- fixedDT[pollutant == "wd" & site %like% "A33"]
windDirDT[, `:=`(wd, value)]
setkey(windDirDT, dateTimeUTC, site, source)
windSpeedDT <- fixedDT[pollutant == "ws" & site %like% "A33"]
windSpeedDT[, `:=`(ws, value)]
setkey(windSpeedDT, dateTimeUTC, site, source)

windDT <- windSpeedDT[windDirDT]
windDT[, `:=`(rTime, hms::as_hms(dateTimeUTC))]
p <- ggplot2::ggplot(windDT[obsDate > as.Date("2020-03-23")], aes(x = dateTimeUTC, y = ws, angle = -wd + 
    90, colour = ws)) + geom_text(label = "→") + theme(legend.position = "bottom") + guides(colour = guide_legend(title = "Wind speed")) + 
    scale_color_continuous(high = "#132B43", low = "#56B1F7")  # normal blue reversed


yMin <- min(windDT[obsDate > as.Date("2020-03-23")]$ws)
yMax <- max(windDT[obsDate > as.Date("2020-03-23")]$ws)
p <- addWeekendsDateTime(p, yMin, yMax)
# p <- addLockdownRectDateTime(p, yMin, yMax)
p <- p + labs(y = "Wind speed", x = "Time", caption = paste0(myParams$weekendCap)) + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1, size = 9))
p + xlim(lubridate::as_datetime("2020-03-23 23:59:59"), NA)  # do this last otherwise adding the weekends takes the plot back to the earliest weekend we annotate

Figure 9.1: Wind direction and speed in Southampton since 23rd March 2020

Figure 9.2 shows a windrose for each of the periods of low/high pollutant levels visible in Figure 3.4:

26 March - 4 April (lower NO2)
7 April - 12 April (higher NO2)
16 April - 23 April (lower NO2)

The windroses indicate the direction the prevailing wind was blowing from and the colour of the ‘paddles’ indicates the strength while the length of the paddles indicates the proportion of observations. As we can see there are clear differences in the wind conditions which correlate with the pollution patterns observed:

the first period with low NO2 was dominated by north-north easterly winds (likely to bring city and motorway air);
the second period when NO2 and particulates were high was dominated by low speed south easterly winds (bringing continental air);
the third period when NO2 was low was again dominated by north easterly winds.

fixedDT[, `:=`(aqPeriod, ifelse(obsDate >= as.Date("2020-03-26") & obsDate <= as.Date("2020-04-04"), "Period 1 - Low: 26/3 - 4/4", 
    NA))]
fixedDT[, `:=`(aqPeriod, ifelse(obsDate >= as.Date("2020-04-07") & obsDate <= as.Date("2020-04-12"), "Period 2 - High: 7/4 - 12/4", 
    aqPeriod))]
fixedDT[, `:=`(aqPeriod, ifelse(obsDate >= as.Date("2020-04-16") & obsDate <= as.Date("2020-04-23"), "Period 3 - Low: 16/4 - 23/4", 
    aqPeriod))]

plotDT <- fixedDT[!is.na(aqPeriod) & (pollutant == "ws" | pollutant == "wd") & site %like% "A33"]

t <- plotDT[, .(start = min(dateTimeUTC), end = max(dateTimeUTC)), keyby = .(aqPeriod)]

kableExtra::kable(t, caption = "Check period start/end times") %>% kable_styling()

Table 9.1: Check period start/end times
aqPeriod	start	end
Period 1 - Low: 26/3 - 4/4	2020-03-26	2020-04-04 23:00:00
Period 2 - High: 7/4 - 12/4	2020-04-07	2020-04-12 23:00:00
Period 3 - Low: 16/4 - 23/4	2020-04-16	2020-04-23 23:00:00

# make a dt openair will accept
wdDT <- plotDT[pollutant == "wd", .(dateTimeUTC, site, wd = value, aqPeriod)]
setkey(wdDT, dateTimeUTC, site, aqPeriod)
wsDT <- plotDT[pollutant == "ws", .(dateTimeUTC, site, ws = value, aqPeriod)]
setkey(wsDT, dateTimeUTC, site, aqPeriod)
wrDT <- wdDT[wsDT]
openair::windRose(wrDT, type = "aqPeriod")

Figure 9.2: Wind rose for Southampton sites since 23rd March 2020

10 Save data

Save long form fixed-date data to savedData for re-use.

fixedDT[, `:=`(weekDay, lubridate::wday(dateTimeUTC, label = TRUE, abbr = TRUE))]
f <- paste0(here::here(), "/savedData/sotonExtract2017_2020_v2.csv")
data.table::fwrite(fixedDT, f)
dkUtils::gzipIt(f)

Saved data description:

skimr::skim(fixedDT)

Table 10.1: Data summary

Name	fixedDT
Number of rows	703754
Number of columns	19
_______________________
Column type frequency:
character	6
Date	3
factor	4
numeric	5
POSIXct	1
________________________
Group variables	None

Variable type: character

skim_variable	n_missing	complete_rate	min	max	n_unique
pollutant	0	1.00	2	5	13
source	0	1.00	4	8	2
site	0	1.00	26	38	4
ratified	0	1.00	1	1	3
compareYear	0	1.00	4	9	2
aqPeriod	694198	0.01	26	27	3

Variable type: Date

skim_variable	complete_rate	min	max	median	n_unique
obsDate	1	2017-01-01	2020-06-02	2018-09-01	1249
date2020	1	2020-01-01	2020-12-30	2020-06-07	365
fixedDate	1	2019-12-29	2020-12-29	2020-06-05	367

Variable type: factor

skim_variable	complete_rate	ordered	n_unique	top_counts
origDoW	1	TRUE	7	Sat: 101353, Sun: 101111, Fri: 100881, Wed: 100211
day2020	1	TRUE	7	Wed: 111096, Mon: 101210, Tue: 101013, Fri: 99781
fixedDoW	1	TRUE	7	Sat: 101353, Sun: 101111, Fri: 100881, Wed: 100211
weekDay	1	TRUE	7	Sat: 101353, Sun: 101111, Fri: 100881, Wed: 100211

Variable type: numeric

skim_variable	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
value	1	40.79	68.27	-9.6	4.83	15.60	42.00	1058.00	▇▁▁▁▁
year	1	2018.19	0.98	2017.0	2017.00	2018.00	2019.00	2020.00	▇▇▁▇▂
month	1	6.13	3.48	1.0	3.00	6.00	9.00	12.00	▇▅▃▅▆
decimalDate	1	2018.65	0.96	2017.0	2017.81	2018.67	2019.45	2020.42	▇▇▇▇▆
weekNo	1	24.79	15.17	1.0	12.00	23.00	38.00	53.00	▇▇▆▆▆

Variable type: POSIXct

skim_variable	n_missing	complete_rate	min	max	median	n_unique
dateTimeUTC	0	1	2017-01-01	2020-06-02 23:00:00	2018-09-01 11:00:00	29976

Saved data sites by year:

t <- table(fixedDT$site, fixedDT$year)

kableExtra::kable(t, caption = "Sites available by year") %>% kable_styling()

Table 10.2: Sites available by year
	2017	2018	2019	2020
Southampton - Onslow Road (near RSH)	25307	25755	24762	6408
Southampton - Victoria Road (Woolston)	19251	23091	11541	6195
Southampton A33 (via AURN)	67278	62214	65751	24059
Southampton Centre (via AURN)	103806	100155	105871	32310

Saved pollutants by site:

t <- table(fixedDT$site, fixedDT$pollutant)

kableExtra::kable(t, caption = "Pollutants available by site") %>% kable_styling()

Table 10.3: Pollutants available by site
	no	no2	nox	nv10	nv2.5	o3	pm10	pm2.5	so2	v10	v2.5	wd	ws
Southampton - Onslow Road (near RSH)	27412	27408	27412	0	0	0	0	0	0	0	0	0	0
Southampton - Victoria Road (Woolston)	20026	20026	20026	0	0	0	0	0	0	0	0	0	0
Southampton A33 (via AURN)	29522	29522	29522	23210	0	0	25564	0	0	23210	0	29376	29376
Southampton Centre (via AURN)	28538	28538	28539	21105	22627	28527	26060	27582	28142	21105	22627	29376	29376

NB:

ws = wind speed
wd = wind direction
v* = volatiles

We have also produced wind/pollution roses for these sites.

11 About

11.1 Code

Source:

https://github.com/dataknut/airQual

History:

https://github.com/dataknut/airQual/commits/master

11.2 Comments and feedback

If you wish to comment please open an issue:

https://github.com/dataknut/airQual/issues

11.3 Citation

If you wish to refer to any of the material from this report please cite as:

Anderson, B., (2020) Air Quality in Southampton (UK): Exploring the effect of UK covid 19 lockdown on air quality , Sustainable Energy Research Group, University of Southampton: Southampton, UK.

Report circulation:

Public

12 Annex

12.1 Missing data

Several of these datasets suffer from missing data or have stopped updating. This is visualised below for all data for all sites from January 2020.

For example 12.1 shows missing data patterns for Nitrogen Dioxide.

# dt,xvar, yvar,fillVar, yLab
yLab <- "NO2"
tileDT <- fixedDT[pollutant == "no2" & dateTimeUTC > as.Date("2020-02-01") & !is.na(value)]
p <- makeTilePlot(tileDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "site", fillVar = "value", 
    yLab = yLab)

p + scale_x_datetime(date_breaks = "7 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1))

Figure 12.1: Nitrogen Dioxide data availability and levels over time

yLab <- "NOx"
# dt,xvar, yvar,fillVar, yLab
tileDT <- fixedDT[pollutant == "nox" & dateTimeUTC > as.Date("2020-02-01") & !is.na(value)]
p <- makeTilePlot(tileDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "site", fillVar = "value", 
    yLab = yLab)

p + scale_x_datetime(date_breaks = "7 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1))

Figure 12.2: Oxides of nitrogen data availability and levels over time

yLab <- "SO2"
# dt,xvar, yvar,fillVar, yLab
tileDT <- fixedDT[pollutant == "so2" & dateTimeUTC > as.Date("2020-02-01") & !is.na(value)]
p <- makeTilePlot(tileDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "site", fillVar = "value", 
    yLab = yLab)

p + scale_x_datetime(date_breaks = "7 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1))

Figure 12.3: Sulphour Dioxide data availability and levels over time

yLab <- "O3"
tileDT <- fixedDT[pollutant == "o3" & dateTimeUTC > as.Date("2020-02-01") & !is.na(value)]
p <- makeTilePlot(tileDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "site", fillVar = "value", 
    yLab = yLab)

p + scale_x_datetime(date_breaks = "7 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1))

Figure 12.4: Availability and level of o3 data over time

yLab <- "PM10"
tileDT <- fixedDT[pollutant == "pm10" & dateTimeUTC > as.Date("2020-02-01") & !is.na(value)]
p <- makeTilePlot(tileDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "site", fillVar = "value", 
    yLab = yLab)

p + scale_x_datetime(date_breaks = "7 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1))

Figure 12.5: Availability and level of PM 10 data over time

yLab <- "PM2.5"
tileDT <- fixedDT[pollutant == "pm2.5" & dateTimeUTC > as.Date("2020-02-01") & !is.na(value)]
p <- makeTilePlot(tileDT, xVar = "dateTimeUTC", xLab = "Date & Time", yVar = "site", fillVar = "value", 
    yLab = yLab)

p + scale_x_datetime(date_breaks = "7 day", date_labels = "%a %d %b") + theme(axis.text.x = element_text(angle = 90, 
    hjust = 1))

Figure 12.6: Availability and level of PM 2.5 data over time

12.2 Ship activity

Exploration of correlations between wind direction, recorded ship activity and pollutants.

Data:

Air quality: AURN
Ship counts: Western docks forum
WHO reference thresholds: https://www.who.int/news-room/fact-sheets/detail/ambient-(outdoor)-air-quality-and-health

It is important to consider the relative locations of the air quality stations and the port activities when interpreting this data. The map below shows the rough location of the stations (coloured circles: green 2 = A33, orange 4 = City Centre) as well as the locations of monitoring stations that, as of June 4th 2020, are not collecting data.

Latest air quality snaphot (June 4th 2020)

shipsDailyDT <- data.table::fread(paste0(aqParams$SCCdataPath, "/shipNumbers/shipNumbersSouthampton.csv"))
shipsDailyDT[, `:=`(rDate, lubridate::dmy(Date))]
shipsDailyDT <- shipsDailyDT[!is.na(rDate)]
# summary(shipsDailyDT$rDate)

shipsDailyDT[, `:=`(allShips, cargo + max_cruise)]
shipsDailyDT[, `:=`(allShipsCoded, ifelse(allShips == 0, "0", NA))]
shipsDailyDT[, `:=`(allShipsCoded, ifelse(allShips == 1 | allShips == 2, "1-2", allShipsCoded))]
shipsDailyDT[, `:=`(allShipsCoded, ifelse(allShips == 3 | allShips == 4, "3-4", allShipsCoded))]
shipsDailyDT[, `:=`(allShipsCoded, ifelse(allShips == 5 | allShips == 6, "5-6", allShipsCoded))]
shipsDailyDT[, `:=`(allShipsCoded, ifelse(allShips > 6, "7+", allShipsCoded))]

# re-code all ships to something more intuitive than openair does
shipsDailyDT[, `:=`(maxCruiseCoded, ifelse(max_cruise == 0, "0", NA))]
shipsDailyDT[, `:=`(maxCruiseCoded, ifelse(max_cruise == 1 | max_cruise == 2, "1-2", maxCruiseCoded))]
shipsDailyDT[, `:=`(maxCruiseCoded, ifelse(max_cruise == 3 | max_cruise == 4, "3-4", maxCruiseCoded))]
shipsDailyDT[, `:=`(maxCruiseCoded, ifelse(max_cruise > 4, "5+", maxCruiseCoded))]
t <- with(shipsDailyDT, table(maxCruiseCoded, allShipsCoded))

kableExtra::kable(addmargins(t), caption = "Number of days with max n cruise ships (rows) vs all ships") %>% 
    kable_styling()

Table 12.1: Number of days with max n cruise ships (rows) vs all ships
	1-2	3-4	5-6	7+	Sum
0	1	0	0	0	1
1-2	4	0	0	0	4
3-4	0	15	12	3	30
5+	0	0	14	12	26
Sum	5	15	26	15	61

dailyNO2DT <- no2dt[obsDate >= as.Date("2020-04-01"), .(meanNO2 = mean(value), maxNO2 = max(value), nObs = .N), 
    keyby = .(site, rDate = obsDate)]
dailyPM10DT <- pm10dt[obsDate >= as.Date("2020-04-01"), .(meanPM10 = mean(value), maxPM10 = max(value), 
    nObs = .N), keyby = .(site, rDate = obsDate)]
# summary(dailyNO2DT$rDate)

windDirDT <- fixedDT[pollutant == "wd", .(site, dateTimeUTC, wd = value)]
windSpeedDT <- fixedDT[pollutant == "ws", .(site, dateTimeUTC, ws = value)]
setkey(windDirDT, site, dateTimeUTC)
setkey(windSpeedDT, site, dateTimeUTC)
windDT <- windSpeedDT[windDirDT]
dailyWindDT <- windDT[dateTimeUTC >= as.Date("2020-04-01"), .(meanWd = mean(wd), meanWs = mean(ws), nObs = .N), 
    keyby = .(site, rDate = as.Date(dateTimeUTC))]


setkey(shipsDailyDT, rDate)
setkey(dailyNO2DT, rDate)
setkey(dailyPM10DT, rDate)

plotNO2DT <- shipsDailyDT[dailyNO2DT]
plotPM10DT <- shipsDailyDT[dailyPM10DT]

setkey(dailyWindDT, site, rDate)
setkey(plotNO2DT, site, rDate)
plotNO2DT <- dailyWindDT[plotNO2DT[site %like% "AURN"]]  # keep AURN only

setkey(dailyWindDT, site, rDate)
setkey(plotPM10DT, site, rDate)
plotPM10DT <- dailyWindDT[plotPM10DT[site %like% "AURN"]]  # keep AURN only
# nrow(plotDT)

Table 12.1 shows the number of days for which there are different maximum numbers of cruise ships (rows) and total cargo and cruise ships (columns). There is only 1 day when there are 0 cruise ships and no days when there are 0 ships. The sparseness of the data (only 61 days) and the relative lack of variation in ship numbers means that a relationship between ship numbers and pollution will be difficult to detect.

In addition, and most importantly, these analyses only show correlations. It it quite possible, for example, that higher pollution levels are due to prevailing environmental/meteorological conditions that happen to coincide with more ships.

12.2.1 NO2

Figures 12.7 and 12.8 shows the distribution of mean and max daily NO2 by maximum cruise ship counts for the day. There are no clear relationships.

myCap <- "April & May 2020 \nSources: AURN hourly observations & Western docks forum"

ggplot2::ggplot(plotNO2DT, aes(x = maxCruiseCoded, y = meanNO2, group = maxCruiseCoded, color = site)) + 
    geom_boxplot() + labs(x = "Max number of cruise ships", y = "Mean daily NO2", caption = myCap) + facet_grid(. ~ 
    site)

Figure 12.7: Box plots of daily mean NO2 by maximum cruise ship counts

ggplot2::ggplot(plotNO2DT, aes(x = maxCruiseCoded, y = maxNO2, group = maxCruiseCoded, color = site)) + 
    geom_boxplot() + labs(x = "Max number of cruise ships", y = "Max daily NO2", caption = paste0(myCap, 
    "\nReference line: WHO hourly threshold")) + facet_grid(. ~ site) + geom_hline(yintercept = myParams$hourlyNo2Threshold_WHO)

Figure 12.8: Box plots of daily max NO2 by maximum cruise ship counts

Figures 12.9 and 12.10 repeats this for all ships. In this case there appears to be slightly more of a rising trend as the number of ships increases.

ggplot2::ggplot(plotNO2DT, aes(x = allShipsCoded, y = meanNO2, group = allShipsCoded, color = site)) + 
    geom_boxplot() + labs(x = "Max number of ships", y = "Mean daily NO2 (hourly observations)", caption = myCap) + 
    facet_grid(. ~ site)

Figure 12.9: Box plots of daily mean NO2 by cargo + cruise ship counts

ggplot2::ggplot(plotNO2DT, aes(x = allShipsCoded, y = maxNO2, group = allShipsCoded, color = site)) + geom_boxplot() + 
    labs(x = "Max number of ships", y = "Max daily NO2 (hourly observations)", caption = paste0(myCap, 
        "\nReference line: WHO hourly threshold")) + facet_grid(. ~ site) + geom_hline(yintercept = myParams$hourlyNo2Threshold_WHO)

Figure 12.10: Box plots of daily max NO2 by cargo + cruise ship counts

Figures 12.11 and 12.12 show pollution roses for daily mean and daily max NO2 by the maximum number of cruise ships alongside per day. These show the most frequent wind directions (wind rose) overlain by the proportion of pollution concentrations in the calculated groups.

It appears that when the wind is from the South East/East and more cruise ships are alongside then higher levels of NO2 are more frequent. But this could also be due to wind-blown continental pollution when the wind is from this direction as was known to be the case during April 2020.

plotNO2DT[, `:=`(wd, meanWd)]
plotNO2DT[, `:=`(ws, meanWs)]
plotNO2DT[site %like% "A33", `:=`(shortSite, "A33")]
plotNO2DT[site %like% "Centre", `:=`(shortSite, "Centre")]

openair::pollutionRose(plotNO2DT[max_cruise != 0], pollutant = "meanNO2", type = c("maxCruiseCoded", "shortSite"))

Figure 12.11: Pollution rose for mean NO2 for April & May 2020 by max number of cruise ships (AURN sites, single day with 0 cruise ships excluded)

openair::pollutionRose(plotNO2DT[max_cruise != 0], pollutant = "maxNO2", type = c("maxCruiseCoded", "shortSite"))

Figure 12.12: Pollution rose for max NO2 for April & May 2020 by max number of cruise ships (AURN sites, single day with 0 cruise ships excluded)

Figures 12.13 and 12.14 show pollution roses for daily mean and daily max NO2 by the number of all ships alongside per day. As we would expect, these plots appear to show a similar effect.

openair::pollutionRose(plotNO2DT, pollutant = "meanNO2", type = c("allShipsCoded", "shortSite"))

Figure 12.13: Pollution rose for mean NO2 for April & May 2020 by number of cruise + cargo ships (AURN sites)

openair::pollutionRose(plotNO2DT, pollutant = "maxNO2", type = c("allShipsCoded", "shortSite"))

Figure 12.14: Pollution rose for max NO2 for April & May 2020 by number of cruise + cargo ships (AURN sites)

12.2.2 PM10

Figures 12.15 and 12.16 show the distribution of mean and max daily PM10 by maximum cruise ship counts for the day. There is no clear relationship.

ggplot2::ggplot(plotPM10DT, aes(x = maxCruiseCoded, y = meanPM10, group = maxCruiseCoded, color = site)) + 
    geom_boxplot() + labs(x = "Max number of cruise ships", y = "Mean daily PM10", caption = paste0(myCap, 
    "\nReference line: WHO 24 hour mean threshold")) + facet_grid(. ~ site) + geom_hline(yintercept = myParams$dailyPm10Threshold_WHO)

Figure 12.15: Box plots of daily mean PM10 by maximum cruise ship counts

ggplot2::ggplot(plotPM10DT, aes(x = maxCruiseCoded, y = maxPM10, group = maxCruiseCoded, color = site)) + 
    geom_boxplot() + labs(x = "Max number of cruise ships", y = "Max daily PM10", caption = myCap) + facet_grid(. ~ 
    site)

Figure 12.16: Box plots of daily max PM10 by maximum cruise ship counts

Figures 12.17 and 12.18 repeat this for all ships. In this case there appears to be a stronger relationship.

myCap <- "April & May 2020 (Sources: AURN & Western docks forum)"

ggplot2::ggplot(plotPM10DT, aes(x = allShipsCoded, y = meanPM10, group = allShipsCoded, color = site)) + 
    geom_boxplot() + labs(x = "Max number of ships", y = "Mean daily PM10", caption = paste0(myCap, "\nReference line: WHO 24 hour mean threshold")) + 
    facet_grid(. ~ site) + geom_hline(yintercept = myParams$dailyPm10Threshold_WHO)

Figure 12.17: Box plots of daily mean PM10 by cargo + cruise ship counts

ggplot2::ggplot(plotPM10DT, aes(x = allShipsCoded, y = maxPM10, group = allShipsCoded, color = site)) + 
    geom_boxplot() + labs(x = "Max number of ships", y = "Max daily PM10 ", caption = myCap) + facet_grid(. ~ 
    site)

Figure 12.18: Box plots of daily max PM10 by cargo + cruise ship counts

Figures 12.19 and 12.20 show pollution roses for daily mean and daily max PM10 by the maximum number of cruise ships alongside per day.

It appears that when the wind is from the South East/East and more cruise ships are alongside then higher levels of PM10 are more frequent. But this is also the case when the wind is from the West in the 3-4 ships category.

plotPM10DT[, `:=`(wd, meanWd)]
plotPM10DT[, `:=`(ws, meanWs)]
plotPM10DT[site %like% "A33", `:=`(shortSite, "A33")]
plotPM10DT[site %like% "Centre", `:=`(shortSite, "Centre")]

openair::pollutionRose(plotPM10DT[max_cruise != 0], pollutant = "meanPM10", type = c("maxCruiseCoded", 
    "shortSite"))

Figure 12.19: Pollution roses for mean PM10 for April & May 2020 by max number of cruise ships (AURN sites, single day with 0 cruise ships excluded)

openair::pollutionRose(plotPM10DT[max_cruise != 0], pollutant = "maxPM10", type = c("maxCruiseCoded", "shortSite"))

Figure 12.20: Pollution roses for max PM10 for April & May 2020 by max number of cruise ships (AURN sites, single day with 0 cruise ships excluded)

Finally, Figures 12.21 and Figures 12.22 show a pollution rose for daily mean and daily max PM10 by the number of all ships alongside per day. These plots appear to show a similar effect. As before it is not possible to discount the potential confounding effects of overall environmental conditions which the South East and Easterly wind directions can produce.

openair::pollutionRose(plotPM10DT, pollutant = "meanPM10", type = c("allShipsCoded", "shortSite"))

Figure 12.21: Pollution roses for mean PM10 for April & May 2020 by number of cruise + cargo ships (AURN sites)

openair::pollutionRose(plotPM10DT, pollutant = "maxPM10", type = c("allShipsCoded", "shortSite"))

Figure 12.22: Pollution roses for max PM10 for April & May 2020 by number of cruise + cargo ships (AURN sites)

12.2.3 Summary

Overall while there appear to be correlations between larger numbers of ships and more frequent higher pollution levels under some wind conditions, the small number of observations and possible confounding meteorological effects mean they could just be spurious. We may need a better measure of ship emissions and we need to take out the meteorological effects.

12.3 Experiments with openair

The openair R package (Carslaw and Ropkins 2012) offers a number of pre-formed plot functions which are of potential use.

cutYear <- 2017  # use as comparison year(s)

12.3.1 NO2 trends with Theil-Sen

openair’s Theil-Sen function provides de-seasoned trendlines. Figure 12.23 shows the trend for NO2 in Southampton Centre over the last 3 years while Figure 12.24 shows the same plot but for the A33 site. Both sites show a faiirly consistent decline over time.

# looking for wide data
no2dt[, `:=`(date, obsDate)]  # set date to date for this one
no2dt[, `:=`(no2, value)]  # looks for named variable

openair::TheilSen(no2dt[site %like% "Centre"], "no2", ylab = "NO2 (ppb)", deseason = TRUE, type = c("site", 
    "weekday"))

## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."

Figure 12.23: Theil-Sen plot for NO2 at Southampton Centre, data points are months

openair::TheilSen(no2dt[site %like% "A33"], "no2", ylab = "NO2 (ppb)", deseason = TRUE, type = c("site", 
    "weekday"))

## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."

Figure 12.24: Theil-Sen plot by weekday for NO2 at Southampton A33 site, data points are months

12.3.2 24 hour NO2 patterns with timeVariation

openair’s timeVariation function provides plots by time of day and weekday. Figure 12.25 shows the pattern for NO2 in Southampton Centre over the Figure 12.26 shows the same plot but for the A33 site. In each case we compare the period before lockdown (from the start of 2017) with the period since lockdown (from 2020-03-24).

These quite clearly show the difference in pollution for pre and during lockdown for specific times of day and days of the week. We can quite clearly see that NO2 has decreased at exactly the times we would expect given the reduction in transport use. This is especially apparent on Mondays and Tuesdays but less obvious on Wednesday to Friday (bottom right plot) with the weekly profile of NO2 emissions looking substantially different.

no2dt[, `:=`(date, dateTimeUTC)]  # set date to dateTime for this one

no2dt[, `:=`(lockdown, ifelse(dateTimeUTC <= myParams$lockDownStartDate, "Pre lockdown", "Lockdown"))]

openair::timeVariation(no2dt[site %like% "Centre" & year >= cutYear], "no2", ylab = "NO2 (ppb)", group = "lockdown")

Figure 12.25: timeVariation plots for NO2 at Southampton Centre comparing lockdown 2020 with pre-lockdown starting in 2017

openair::timeVariation(no2dt[site %like% "A33" & year > cutYear], "no2", ylab = "NO2 (ppb)", group = "lockdown")

Figure 12.26: timeVariation plots for NO2 at Southampton A33 site comparing lockdown 2020 with pre-lockdown starting in 2017

12.3.3 PM10 trends with Theil-Sen

openair’s Theil-Sen function provides de-seasoned trendlines. Figure 12.27 shows the trend for PM10 in Southampton Centre over the last 3 years while Figure 12.28 shows the same plot but for the A33 site.

pm10dt[, `:=`(date, obsDate)]
pm10dt[, `:=`(pm10, value)]

openair::TheilSen(pm10dt[site %like% "Centre"], "pm10", ylab = "PM10", deseason = TRUE, type = c("site", 
    "weekday"))

## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."

Figure 12.27: Theil-Sen plot for PM10 at Southampton Centre, data points are months

openair::TheilSen(pm10dt[site %like% "A33"], "pm10", ylab = "NO2 (ppb)", deseason = TRUE, type = c("site", 
    "weekday"))

## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."

Figure 12.28: Theil-Sen plot by weekday for PM10 at Southampton A33 site, data points are months

12.3.4 24 hour PM10 patterns with timeVariation

Figure 12.29 shows the pattern for PM10 in Southampton Centre over the Figure 12.30 shows the same plot but for the A33 site. In each case we compare the period before lockdown (from the start of 2017) with the period since lockdown (from 2020-03-24).

Unlike NO2, PM10 has not declined presumably because it is not affected by reduced transport use etc.

pm10dt[, `:=`(date, dateTimeUTC)]
pm10dt[, `:=`(lockdown, ifelse(dateTimeUTC <= myParams$lockDownStartDate, "Pre lockdown", "Lockdown"))]

openair::timeVariation(pm10dt[site %like% "Centre" & year >= cutYear], "pm10", ylab = "PM10", group = "lockdown")  # use group to give before/after

Figure 12.29: timeVariation plots for PM10 at Southampton Centre comparing lockdown 2020 with pre-lockdown starting in 2017

openair::timeVariation(pm10dt[site %like% "A33" & year > cutYear], "pm10", ylab = "PM10", group = "lockdown")

Figure 12.30: timeVariation plots for PM10 at Southampton A33 site comparing lockdown 2020 with pre-lockdown starting in 2017

12.3.5 PM2.5 trends with Theil-Sen

openair’s Theil-Sen function provides de-seasoned trendlines. Figure 12.31 shows the trend for PM2.5 in Southampton Centre over the last 3 years.

pm25dt[, `:=`(date, obsDate)]
pm25dt[, `:=`(pm25, value)]

openair::TheilSen(pm25dt[site %like% "Centre"], "pm25", ylab = "PM2.5", deseason = TRUE, type = c("site", 
    "weekday"))

## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."
## [1] "Taking bootstrap samples. Please wait."

Figure 12.31: Theil-Sen plot for PM2.5 at Southampton Centre, data points are months

12.3.6 24 hour PM25 patterns with timeVariation

openair’s timeVariation function provides plots by time of day and weekday. Figure 12.32 shows the pattern for PM25 in Southampton Centre. We compare the period before lockdown (from the start of 2019) with the period since lockdown (from 2020-03-24).

As with PM10, PM2.5 has not declined presumably because it is not affected by reduced transport use etc.

pm25dt[, `:=`(date, dateTimeUTC)]
pm25dt[, `:=`(lockdown, ifelse(dateTimeUTC <= myParams$lockDownStartDate, "Pre lockdown", "Lockdown"))]

openair::timeVariation(pm25dt[site %like% "Centre" & year >= cutYear], "pm25", ylab = "PM2.5", group = "lockdown")

Figure 12.32: timeVariation plots for PM2.5 at Southampton Centre comparing lockdown 2020 with pre-lockdown starting in 2019

13 Runtime

Report generated using knitr in RStudio with R version 3.6.0 (2019-04-26) running on x86_64-redhat-linux-gnu (#1 SMP Tue Feb 18 16:39:12 EST 2020).

t <- proc.time() - myParams$startTime

elapsed <- t[[3]]

Analysis completed in 130.548 seconds ( 2.18 minutes).

R packages used in this report:

data.table - (Dowle et al. 2015)
ggplot2 - (Wickham 2009)
here - (Müller 2017)
kableExtra - (Zhu 2019)
lubridate - (Grolemund and Wickham 2011)
openAir - (Carslaw and Ropkins 2012)
skimr - (Arino de la Rubia et al. 2017)
viridis - (Garnier 2018)

References

Arino de la Rubia, Eduardo, Hao Zhu, Shannon Ellis, Elin Waring, and Michael Quinn. 2017. Skimr: Skimr. https://github.com/ropenscilabs/skimr.

Carslaw, David C., and Karl Ropkins. 2012. “Openair — an R Package for Air Quality Data Analysis.” Environmental Modelling & Software 27–28 (0): 52–61. doi:10.1016/j.envsoft.2011.09.008.

Dowle, M, A Srinivasan, T Short, S Lianoglou with contributions from R Saporta, and E Antonyan. 2015. Data.table: Extension of Data.frame. https://CRAN.R-project.org/package=data.table.

Garnier, Simon. 2018. Viridis: Default Color Maps from ’Matplotlib’. https://CRAN.R-project.org/package=viridis.

Grolemund, Garrett, and Hadley Wickham. 2011. “Dates and Times Made Easy with lubridate.” Journal of Statistical Software 40 (3): 1–25. http://www.jstatsoft.org/v40/i03/.

Müller, Kirill. 2017. Here: A Simpler Way to Find Your Files. https://CRAN.R-project.org/package=here.

Wickham, Hadley. 2009. Ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York. http://ggplot2.org.

Zhu, Hao. 2019. KableExtra: Construct Complex Table with ’Kable’ and Pipe Syntax. https://CRAN.R-project.org/package=kableExtra.

Air Quality in Southampton (UK)

Exploring the effect of UK covid 19 lockdown on air quality

Ben Anderson (b.anderson@soton.ac.uk `@dataknut`)

Last run at: 2020-06-03 21:39:50 (Europe/London)

1 Introduction

2 WHO air quality thresholds

3 Nitrogen Dioxide (no2)

4 Oxides of Nitrogen (nox)

5 Sulphour Dioxide

6 Ozone

7 PM 10

8 PM 2.5

9 Wind direction and speed

10 Save data

11 About

11.1 Code

11.2 Comments and feedback

11.3 Citation

12 Annex

12.1 Missing data

12.2 Ship activity

12.2.1 NO2

12.2.2 PM10

12.2.3 Summary

12.3 Experiments with openair

12.3.1 NO2 trends with Theil-Sen

12.3.2 24 hour NO2 patterns with timeVariation

12.3.3 PM10 trends with Theil-Sen

12.3.4 24 hour PM10 patterns with timeVariation

12.3.5 PM2.5 trends with Theil-Sen

12.3.6 24 hour PM25 patterns with timeVariation

13 Runtime

References

Air Quality in Southampton (UK)

Exploring the effect of UK covid 19 lockdown on air quality

Ben Anderson (b.anderson@soton.ac.uk @dataknut)

Last run at: 2020-06-03 21:39:50 (Europe/London)

1 Introduction

2 WHO air quality thresholds

3 Nitrogen Dioxide (no2)

4 Oxides of Nitrogen (nox)

5 Sulphour Dioxide

6 Ozone

7 PM 10

8 PM 2.5

9 Wind direction and speed

10 Save data

11 About

11.1 Code

11.2 Comments and feedback

11.3 Citation

12 Annex

12.1 Missing data

12.2 Ship activity

12.2.1 NO2

12.2.2 PM10

12.2.3 Summary

12.3 Experiments with openair

12.3.1 NO2 trends with Theil-Sen

12.3.2 24 hour NO2 patterns with timeVariation

12.3.3 PM10 trends with Theil-Sen

12.3.4 24 hour PM10 patterns with timeVariation

12.3.5 PM2.5 trends with Theil-Sen

12.3.6 24 hour PM25 patterns with timeVariation

13 Runtime

References

Ben Anderson (b.anderson@soton.ac.uk `@dataknut`)